# tclgpg.test --
#
#       This file is part of the TclGPG library. It contains tests.
#
# Copyright (c) 2008-2014 Sergei Golovan <sgolovan@nes.ru>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAMER OF ALL WARRANTIES.
#
# $Id: tclgpg.test 76 2014-01-28 17:20:29Z sgolovan $

package require tcltest 2

namespace import tcltest::*

set auto_path [linsert $auto_path 0 [file dirname [info script]]]

set env(GNUPGHOME) [file join [file dirname [info script]] gnupg]
catch {file attributes $env(GNUPGHOME) -permissions 0700}

package forget gpg
package require -exact gpg 1.0

test new-1.1 {Create context} -body {
    set c [::gpg::new]
    list [string equal [info procs $c] $c] \
                  [string equal [info vars $c] $c]
} -result {1 1} -cleanup {$c free}

test free-1.1 {Create and destroy context} -body {
    set c [::gpg::new]
    $c free
    list [info procs $c] [info vars $c]
} -result {{} {}}

test set-1.1 {Set armor property} -body {
    set c [::gpg::new]
    $c set -property armor -value true
    $c set -property armor
} -result true -cleanup {$c free}

test set-1.2 {Set textmode property} -body {
    set c [::gpg::new]
    $c set -property textmode -value true
    $c set -property textmode
} -result true -cleanup {$c free}

test set-1.3 {Set encoding property} -body {
    set c [::gpg::new]
    $c set -property encoding -value utf-8
    $c set -property encoding
} -result utf-8 -cleanup {$c free}

test set-1.4 {Set passphrase-encoding property} -body {
    set c [::gpg::new]
    $c set -property passphrase-encoding -value utf-8
    $c set -property passphrase-encoding
} -result utf-8 -cleanup {$c free}

test set-1.5 {Set passphrase-callback property} -body {
    set c [::gpg::new]
    $c set -property passphrase-callback -value pcb
    $c set -property passphrase-callback
} -result pcb -cleanup {$c free}

test set-1.6 {Set unknown property} -body {
    set c [::gpg::new]
    $c set -property unknown -value val
} -returnCodes error \
    -result {unknown property "unknown":\
        must be armor, textmode, passphrase-callback,\
        signers, encoding, passphrase-encoding, or last-op-info} \
    -cleanup {$c free}

test set-1.7 {Query unknown property} -body {
    set c [::gpg::new]
    $c set -property unknown
} -returnCodes error \
    -result {unknown property "unknown":\
        must be armor, textmode, passphrase-callback, signers,\
        encoding, passphrase-encoding, or last-op-info} \
    -cleanup {$c free}

test set-1.8 {Set armor property to invalid value} -body {
    set c [::gpg::new]
    $c set -property armor -value v
} -returnCodes error \
    -result {invalid armor value "v": must be boolean} \
    -cleanup {$c free}

test set-1.9 {Set textmode property to invalid value} -body {
    set c [::gpg::new]
    $c set -property textmode -value v
} -returnCodes error \
    -result {invalid textmode value "v": must be boolean} \
    -cleanup {$c free}

test set-1.10 {Set with no arguments} -body {
    set c [::gpg::new]
    $c set
} -returnCodes error \
    -result {wrong # args: should be set -property propertyName\
        ?-value value?} \
    -cleanup {$c free}

test set-1.11 {Set with an incorrect option} -body {
    set c [::gpg::new]
    $c set -prop armor
} -returnCodes error \
    -result {unknown option "-prop": must be -property or -value} \
    -cleanup {$c free}

test set-1.12 {Set with extraneous arguments} -body {
    set c [::gpg::new]
    $c set -property textmode -value true -property armor -value true
} -returnCodes error \
    -result {wrong # args: should be set -property propertyName\
        ?-value value?} \
    -cleanup {$c free}

test unset-1.1 {Unset armor property} -body {
    set c [::gpg::new]
    $c unset -property armor
    $c set -property armor
} -result false -cleanup {$c free}

test unset-1.2 {Unset textmode property} -body {
    set c [::gpg::new]
    $c unset -property textmode
    $c set -property textmode
} -result false -cleanup {$c free}

test unset-1.3 {Unset encoding property} -body {
    set c [::gpg::new]
    $c unset -property encoding
    $c set -property encoding
} -result [encoding system] -cleanup {$c free}

test unset-1.4 {Unset passphrase-encoding property} -body {
    set c [::gpg::new]
    $c unset -property passphrase-encoding
    $c set -property passphrase-encoding
} -result [encoding system] -cleanup {$c free}

test unset-1.5 {Unset passphrase-callback property} -body {
    set c [::gpg::new]
    $c unset -property passphrase-callback
    $c set -property passphrase-callback
} -returnCodes error \
    -result {property "passphrase-callback" is not set} \
    -cleanup {$c free}

test unset-1.6 {Unset unknown property} -body {
    set c [::gpg::new]
    $c unset -property unknown
} -returnCodes error \
    -result {unknown property "unknown": must be armor,\
        textmode, passphrase-callback, signers, encoding,\
        or passphrase-encoding} \
    -cleanup {$c free}

test unset-1.7 {Unset without a property} -body {
    set c [::gpg::new]
    $c unset
} -returnCodes error \
    -result {wrong # args: should be unset -property propertyName} \
    -cleanup {$c free}

test unset-1.8 {Unset with an incorrect option} -body {
    set c [::gpg::new]
    $c unset -prop armor
} -returnCodes error \
    -result {unknown option "-prop": must be -property} \
    -cleanup {$c free}

set keylist {0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712\
             2F97ECD7444AB86A649A2138DBD996EC2D5BBFDB\
             61F33F648D8D47DC21F5CE1F1FC8896DFEA3B10D\
             6A5E179C7201BA252BEEC16F36F27239DFA10A4E\
             CC13143A088AEECCB99AF05778E9B5C778DC9112\
             E815CCABAEF4BBEA0DDD654D137F583FA1E4655D}

test list-keys-1.1 {List all public keys synchronously} -body {
    set c [::gpg::new]
    lsort [$c list-keys]
} -result $keylist -cleanup {$c free}

test list-keys-1.2 {List all public keys asynchronously} -setup {
    proc ::result {status keys} {
        set ::listkeys [list $status $keys]
    }
    catch {unset ::listkeys}
} -body {
    set c [::gpg::new]
    $c list-keys -command ::result
    vwait ::listkeys
    list [lindex $::listkeys 0] [lsort [lindex $::listkeys 1]]
} -cleanup {
    $c free
    rename ::result ""
    unset ::listkeys
} -result [list ok $keylist]

test list-keys-1.3 {List matching public keys synchronously} -body {
    set c [::gpg::new]
    $c list-keys -patterns {revoked}
} -result {6A5E179C7201BA252BEEC16F36F27239DFA10A4E\
        2F97ECD7444AB86A649A2138DBD996EC2D5BBFDB} -cleanup {$c free}

test list-keys-2.1 {List all secret keys synchronously} -body {
    set c [::gpg::new]
    lsort [$c list-keys -secretonly true]
} -result $keylist -cleanup {$c free}

test list-keys-2.2 {List all secret keys asynchronously} -setup {
    proc ::result {status keys} {
        set ::listkeys [list $status $keys]
    }
    catch {unset ::listkeys}
} -body {
    set c [::gpg::new]
    $c list-keys -secretonly true -command ::result
    vwait ::listkeys
    list [lindex $::listkeys 0] [lsort [lindex $::listkeys 1]]
} -cleanup {
    $c free
    rename ::result ""
    unset ::listkeys
} -result [list ok $keylist]

test list-keys-2.3 {List matching secret keys synchronously} -body {
    set c [::gpg::new]
    $c list-keys -patterns {working}
} -result {0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712} -cleanup {$c free}

test info-key-1.1 {Info of matching public key} -body {
    set c [::gpg::new]
    set keys [$c list-keys -patterns {working}]
    array set ares [$c info-key -key [lindex $keys 0]]
    # TODO use plain [array get] may be?
    list $ares(keyid) $ares(name) $ares(comment) $ares(email)
} -result {4A6276E6C52F1712 {Sergei Golovan}\
        {working key for testing TclGPG} sgolovan@gmail.com} \
    -cleanup {$c free}

proc pcb1 {args} {
    return 1234567890
}

proc pcb2 {args} {
    return 0987654321
}

proc pcb3 {args} {
    return -code break ""
}

set message "Hello \u041f\u0440\u0438\u0432\u0435\u0442"

test encrypt-decrypt-1.1 {Symmetric cipher (armored)} -body {
    set c [::gpg::new]
    $c set -property armor -value true
    $c set -property passphrase-callback -value pcb1
    $c set -property encoding -value utf-8
    $c decrypt -input [$c encrypt -input $message]
} -result [list plaintext $message] -cleanup {$c free}

test encrypt-decrypt-1.2 {Symmetric cipher (unarmored)} -body {
    set c [::gpg::new]
    $c set -property armor -value false
    $c set -property passphrase-callback -value pcb1
    $c set -property encoding -value utf-8
    $c decrypt -input [$c encrypt -input $message]
} -result [list plaintext $message] -cleanup {$c free}

test encrypt-decrypt-1.3 {Symmetric cipher & incorrect passphrase} -body {
    set c [::gpg::new]
    $c set -property armor -value true
    $c set -property passphrase-callback -value pcb1
    $c set -property encoding -value utf-8
    set msg [$c encrypt -input $message]
    $c set -property passphrase-callback -value pcb2
    $c decrypt -input $msg
} -cleanup {
    $c free
    unset msg
} -returnCodes error -result {Decryption failed}

test encrypt-decrypt-1.4 {Symmetric cipher & missing passphrase} -body {
    set c [::gpg::new]
    $c set -property armor -value true
    $c set -property passphrase-callback -value pcb1
    $c set -property encoding -value utf-8
    set msg [$c encrypt -input $message]
    $c set -property passphrase-callback -value pcb3
    $c decrypt -input $msg
} -cleanup {
    $c free
    unset msg
} -returnCodes error -result {No passphrase}

test encrypt-decrypt-1.5 {Symmetric cipher & missing passphrase callback} -body {
    set c [::gpg::new]
    $c set -property armor -value true
    $c set -property passphrase-callback -value pcb1
    $c set -property encoding -value utf-8
    set msg [$c encrypt -input $message]
    $c unset -property passphrase-callback
    $c decrypt -input $msg
} -cleanup {
    $c free
    unset msg
} -returnCodes error -result {No passphrase callback}

test sign-verify-1.1 {Ordinary sign (armored)} -body {
    set c [::gpg::new]
    $c set -property armor -value true
    $c set -property passphrase-callback -value pcb1
    $c set -property encoding -value utf-8
    $c set -property signers -value 0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712
    set sig [$c sign -input $message]
    array set ares [$c verify -signature $sig]
    list $ares(status) $ares(plaintext)
} -cleanup {
    $c free
    unset sig ares
} -result [list good $message]

test sign-verify-1.2 {Ordinary sign (unarmored)} -body {
    set c [::gpg::new]
    $c set -property armor -value false
    $c set -property passphrase-callback -value pcb1
    $c set -property encoding -value utf-8
    $c set -property signers -value 0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712
    set sig [$c sign -input $message]
    array set ares [$c verify -signature $sig]
    list $ares(status) $ares(plaintext)
} -cleanup {
    $c free
    unset sig ares
} -result [list good $message]

test sign-verify-1.3 {Detached sign (armored)} -body {
    set c [::gpg::new]
    $c set -property armor -value true
    $c set -property passphrase-callback -value pcb1
    $c set -property encoding -value utf-8
    $c set -property signers -value 0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712
    set sig [$c sign -input $message -mode detach]
    array set ares [$c verify -signature $sig -input $message]
    set ares(status)
} -cleanup {
    $c free
    unset sig ares
} -result good

test sign-verify-1.4 {Detached sign (unarmored)} -body {
    set c [::gpg::new]
    $c set -property armor -value false
    $c set -property passphrase-callback -value pcb1
    $c set -property encoding -value utf-8
    $c set -property signers -value 0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712
    set sig [$c sign -input $message -mode detach]
    array set ares [$c verify -signature $sig -input $message]
    set ares(status)
} -cleanup {
    $c free
    unset sig ares
} -result good

test sign-verify-1.5 {Clear sign} -body {
    set c [::gpg::new]
    $c set -property passphrase-callback -value pcb1
    $c set -property encoding -value utf-8
    $c set -property signers -value 0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712
    set sig [$c sign -input $message -mode clear]
    array set ares [$c verify -signature $sig]
    list $ares(status) $ares(plaintext)
} -cleanup {
    $c free
    unset sig ares
} -result [list good $message\n]

test sign-1.1 {Sign with no passphrase} -body {
    set c [::gpg::new]
    $c set -property passphrase-callback -value pcb3
    $c set -property encoding -value utf-8
    $c set -property signers -value 0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712
    $c sign -input $message
} -returnCodes error -result {No passphrase} -cleanup {$c free}

test sign-1.2 {Sign with incorrect passphrase} -body {
    set c [::gpg::new]
    $c set -property passphrase-callback -value pcb2
    $c set -property encoding -value utf-8
    $c set -property signers -value 0FCE5909C0AD7044BAF1C2A94A6276E6C52F1712
    $c sign -input $message
} -returnCodes error -result {Bad passphrase} -cleanup {$c free}

test sign-1.3 {Sign with revoked key} -body {
    set c [::gpg::new]
    $c set -property passphrase-callback -value pcb1
    $c set -property encoding -value utf-8
    $c set -property signers -value 6A5E179C7201BA252BEEC16F36F27239DFA10A4E
    $c sign -input $message
} -returnCodes error -result {Key is unusable} -cleanup {$c free}

test encrypt-1.1 {Encrypt to unknown recipient} -body {
    set c [::gpg::new]
    set r [::gpg::recipient]
    $r add -name unknown@example.org -validity full
    puts stderr [$c encrypt -input $message -recipients $r]
} -cleanup {
    $c free
    $r free
} -returnCodes error -result {Public key not found}

test encrypt-1.2 {Encrypt to a recipient with expired key} -body {
    set c [::gpg::new]
    set r [::gpg::recipient]
    $r add -name sergei@golovan.ru -validity full
    $c encrypt -input $message -recipients $r
} -cleanup {
    $c free
    $r free
} -returnCodes error -result {Public key not found}

test encrypt-1.3 {Encrypt to a recipient with revoked key} -body {
    set c [::gpg::new]
    set r [::gpg::recipient]
    $r add -name sergei1@golovan.ru -validity full
    $c encrypt -input $message -recipients $r
} -cleanup {
    $c free
    $r free
} -returnCodes error -result {Public key not found}

test encrypt-1.4 {Encrypt to a recipient with both expired&valid keys} -body {
    set c [::gpg::new]
    set r [::gpg::recipient]
    $r add -name sgolovan@gmail.com -validity full
    $c encrypt -input $message -recipients $r
    list ok ; # only testing non-error status
} -cleanup {
    $c free
    $r free
} -result {ok}

test decrypt-1.1 {Decrypt with a revoked key} -body {
    set c [::gpg::new]
    $c set -property passphrase-callback -value pcb1
    $c set -property encoding -value utf-8
    $c decrypt -input \
"-----BEGIN PGP MESSAGE-----
Version: GnuPG v1.4.6 (GNU/Linux)

hIwDH92Qmdvb5zoBA/0ZuZSuX/t7mybydfWfgiAuWttcvMKbT71MgyMlI9JJHK5/
D2qq0bISQAClMBYuFmv12TM5ar3jp/ixbOfXsTLbWtim4asHdZYQ0Adm9Z8umHjm
38GZo7NWg/kEnPGyElmmBqvBHbgdpV1ToswQY+yxYRibpCuCCgZbFr4ml9IFBdJO
AbzATKk7pm5fkM9lHy/k4DHDwtpYmjuBId7H/muc0yYCFjSY0CpBFWmW0r/1GSRI
NZCKk8sVxdQlM039q/PjwvwuJ5HVcw9SjrxluFky
=tcxU
-----END PGP MESSAGE-----"
} -cleanup {
    $c free
} -result [list plaintext $message]

test decrypt-1.2 {Decrypt incorrect message} -body {
    set c [::gpg::new]
    $c set -property passphrase-callback -value pcb1
    $c decrypt -input \
"-----BEGIN PGP MESSAGE-----
Version: GnuPG v1.4.6 (GNU/Linux)

hIwDH92Qmdvb5zoBA/0ZuZSuX/t7mybydfWfgiAuWttcvMKbT71MgyMlI9JJHK5/
AbzATKk7pm5fkM9lHy/k4DHDwtpYmjuBId7H/muc0yYCFjSY0CpBFWmW0r/1GSRI
NZCKk8sVxdQlM039q/PjwvwuJ5HVcw9SjrxluFky
=tcxU
-----END PGP MESSAGE-----"
} -cleanup {
    $c free
} -returnCodes error -result {Encrypted message is corrupted}

test decrypt-1.3 {Decrypt with an incorrect passphrase} -body {
    set c [::gpg::new]
    $c set -property passphrase-callback -value pcb2
    $c decrypt -input \
"-----BEGIN PGP MESSAGE-----
Version: GnuPG v1.4.6 (GNU/Linux)

hIwDH92Qmdvb5zoBA/0ZuZSuX/t7mybydfWfgiAuWttcvMKbT71MgyMlI9JJHK5/
D2qq0bISQAClMBYuFmv12TM5ar3jp/ixbOfXsTLbWtim4asHdZYQ0Adm9Z8umHjm
38GZo7NWg/kEnPGyElmmBqvBHbgdpV1ToswQY+yxYRibpCuCCgZbFr4ml9IFBdJO
AbzATKk7pm5fkM9lHy/k4DHDwtpYmjuBId7H/muc0yYCFjSY0CpBFWmW0r/1GSRI
NZCKk8sVxdQlM039q/PjwvwuJ5HVcw9SjrxluFky
=tcxU
-----END PGP MESSAGE-----"
} -cleanup {
    $c free
} -returnCodes error -result {Decryption failed}

test decrypt-1.4 {Decrypt and check the signature} -body {
    set c [::gpg::new]
    set r [::gpg::recipient]
    $r add -name sgolovan@gmail.com -validity full
    $c encrypt -input $message -recipients $r
    list ok ; # only testing non-error status
} -cleanup {
    $c free
    $r free
} -result {ok}

cleanupTests

# vim:ts=8:sw=4:sts=4:et:ft=tcl
